unit Speed;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    Button1: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure BubbleSort;
    procedure AdvancedBubbleSort;
    procedure ShakerSort;
    procedure Heapsort;
    procedure GnomeSort;
    procedure Draw;
  end;
const
n = 3000;
w = 20;
yo = 40;
xo = 20;
var
  Form1: TForm1;
  a, p, x : array of integer;
  s : array of string;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.AdvancedBubbleSort;
var i, j, temp : integer; change : boolean;
begin
  for i:=0 to n-2 do
  begin
    change := false;
    for j:=0 to n-2-i do
    begin
      if a[j]>a[j+1] then
      begin
        temp := a[j];
        a[j] := a[j+1];
        a[j+1] := temp;
        change := true;
      end;
    end;
    if change = false then break;
  end;
end;

procedure TForm1.BubbleSort;
var i, j, temp : integer;
begin
  for i:=0 to n-2 do
    for j:=0 to n-2-i do
    begin
      if a[j] > a[j+1] then
      begin
        temp := a[j];
        a[j] := a[j+1];
        a[j+1] := temp;
      end;
    end;
end;

procedure TForm1.GnomeSort;
var i, temp : integer;
begin
  i:=0;
  while i<>n-1 do
  begin
    if i=0 then i:=i+1;
    if a[i-1]>a[i] then
    begin
      temp := a[i-1];
      a[i-1] := a[i];
      a[i] := temp;
      i := i-1;
    end else
    begin
      i := i+1;
    end;
  end;
end;

procedure TForm1.Heapsort;
var L, R, temp : integer;
procedure sift(L, R : integer);
var i, j, x : integer;
begin
  i:=L;
  j:= 2*i+1;
  x := a[i];
  if (j<R) and (a[j]<a[j+1]) then j:=j+1;
  while (j<=R) and (x < a[j]) do
  begin
    a[i] := a[j];
    i := j;
    j := 2*j + 1;
    if (j<R) and (a[j]<a[j+1]) then j:=j+1;
  end;
  a[i] := x;
end;
procedure makeheap;
var L : integer;
begin
  L := n div 2;
  while L>0 do
  begin
    L := L-1;
    sift(l, n-1);
  end;
end;
begin
  makeheap;
  L := 0;
  R := n-1;
  while R>0 do
  begin
    temp := a[0];
    a[0] := a[R];
    a[R] := temp;
    R := R-1;
    sift(L, R);
  end;
end;

procedure TForm1.ShakerSort;
var i, j, temp : integer; change : boolean;
begin
  for i:=0 to n div 2 do
  begin
    change := false;
    for j:=i-1 to n-i-1 do
    begin
      if a[j]>a[j+1] then
      begin
        temp := a[j];
        a[j] := a[j+1];
        a[j+1] := temp;
        change := true;
      end;
    end;
    for j:=n-i-1 downto i-1 do
    begin
      if a[j]>a[j+1] then
      begin
        temp := a[j];
        a[j] := a[j+1];
        a[j+1] := temp;
        change := true;
      end;
    end;
    if change = false then break;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var t, time : integer;
  procedure Reset;
  var i:integer;
  begin
    for i:=0 to n-1 do
      a[i] := p[i];
  end;
  procedure MainReset;
  var i:integer;
  begin
    randomize;
    for i:=0 to n-1 do
    begin
      a[i] := random(50);
      p[i] := a[i];
    end;
  end;
begin
  MainReset;

  t := GetTickCount;
  BubbleSort;
  time := GetTickCount;
  x[0] := x[0]+(time-t);
  Reset;

  t :=  GetTickCount;
  AdvancedBubbleSort;
  time := GetTickCount;
  x[1] := x[1]+(time - t);
  Reset;

  t := GetTickCount;
  ShakerSort;
  time := GetTickCount;
  x[2] := x[2]+(time-t);
  Reset;

  t := GetTickCount;
  HeapSort;
  time := GetTickCount;
  x[3] := x[3]+(time - t);
  Reset;

  t := GetTickCount;
  GnomeSort;
  time := GetTickCount;
  x[4] := x[4]+(time-t);
  Reset;
  
  Draw;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  setlength(a, n);
  setlength(p, n);
  setlength(x, 5);
  setlength(s, 5);
  s[0] := 'BubbleSort';
  s[1] := 'AdvancedBubbleSort';
  s[2] := 'ShakerSort';
  s[3] := 'Heapsort';
  s[4] := 'GnomeSort';
  randomize;
  for i:=0 to 4 do
    x[i] := 0;
end;

procedure TForm1.Draw;
var
  i, max : integer; k : real;
begin
  Form1.Image1.Canvas.Rectangle(ClientRect);
  max := xo+x[0]+length(s[0])+length(inttostr(x[0]));
  for i:=1 to 4 do
  begin
    if length(inttostr(x[0]))+xo+x[i]+length(s[i])>max then
      max := xo+x[i]+length(s[i])+length(inttostr(x[i]));
  end;
  k := ((Image1.Width-200)/max);
  for i:=0 to 4 do
  begin
    Form1.Image1.Canvas.Rectangle(xo, yo*(1+i), xo+round((x[i])*k), yo*(1+i)+w);
  end;
  Form1.Image1.Canvas.Pen.Width := 2;
  for i:=0 to 4 do
  begin
    Form1.Image1.Canvas.TextOut(xo+round((x[i]*k)), yo*(1+i), inttostr(x[i])+'ms'+' '+s[i]);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FormCreate(Form1);
  Timer1.Enabled := True;
end;

end.
